home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0051_Scale Bitmats.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-08  |  1KB  |  56 lines
  1. {
  2. ===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 05-26-93 (00:24)             Number: 24154
  5. From: SEAN PALMER                  Refer#: NONE
  6.   To: ALL                           Recvd: NO
  7. Subj: SCALING BITMAPS                Conf: (1221) F-PASCAL
  8. ---------------------------------------------------------------------------
  9. Don't know if anyone is interested, but here is some code to scale
  10. bitmaps. I JUST now wrote it, and it's tested, but it hasn't even begun
  11. to be optimized yet (that's why it's still postable in the Pascal Echo,
  12. no .ASM stuff yet)  8)
  13.  
  14. works with VGA mode $13. }
  15.  
  16. type
  17.  fixed=record case boolean of
  18.         true:(l:longint);
  19.         false:(f:word;i:integer);
  20.         end;
  21.  
  22. procedure scaleBitmap(var bitmap;x,y:word;x1,y1,x2,y2:word);
  23. var
  24.  a,i:word;
  25.  sx,sy,cy,s:fixed;
  26.  map:array[0..65521]of byte absolute bitmap;
  27. begin
  28.  sx.l:=(x*$10000)div succ(x2-x1); sy.l:=(y*$10000)div succ(y2-y1);
  29.  cy.i:=pred(y); cy.f:=$FFFF;
  30.  while cy.i>=0 do begin
  31.   a:=y2*320+x1;
  32.   s.l:=(cy.i*x)*$10000;
  33.   for i:=x2-x1 downto 0 do begin
  34.    mem[$A000:a]:=map[s.i];
  35.    inc(a);
  36.    inc(s.l,sx.l);
  37.    end;
  38.   dec(cy.l,sy.l); dec(y2);
  39.   end;
  40.  end;
  41.  
  42. const
  43.  bmp:array[0..3,0..3]of byte=
  44.   ((0,1,2,3),
  45.    (1,2,3,4),
  46.    (2,3,4,5),
  47.    (3,4,5,6));
  48. var i:integer;
  49.  
  50. begin
  51.  asm mov ax,$13; int $10; end;
  52.  for i:=1 to 99 do
  53.   scaleBitMap(bmp,4,4,0,0,i*2,i*2);
  54.  asm mov ax,$3; int $10; end;
  55.  end.
  56.